home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / Assembly / CalcCRC.p < prev    next >
Text File  |  1996-05-29  |  2KB  |  84 lines
  1. unit CalcCRC;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     var
  9.         crctabl:Handle;
  10.     
  11.     procedure StartupCalcCRC;
  12.     procedure CalcMBCRC (var crc: integer; v: integer);
  13.     procedure CalcMBCRCBlock (p: univ Ptr; len: longint; var crc: integer);
  14.  
  15. implementation
  16.  
  17.     uses
  18.         Resources, Errors, ToolUtils,
  19.         MyStartup;
  20.         
  21.     type
  22.         CRCTablArray = array[0..255] of integer;
  23.         CRCTablArrayPtr = ^CRCTablArray;
  24.         CRCTablArrayHandle = ^CRCTablArrayPtr;
  25.  
  26. {$IFC GENERATINGPOWERPC}
  27.  
  28.     procedure CalcMBCRC (var crc: integer; v: integer);
  29.     begin
  30.         crc:=BXOR(CRCTablArrayHandle(crctabl)^^[BAND(BXOR(BSR(crc,8),v),$FF)],BSL(crc,8));
  31.     end;
  32.  
  33.     procedure CalcMBCRCBlock (p: univ Ptr; len: longint; var crc: integer);
  34.         var
  35.             cp:CRCTablArrayPtr;
  36.     begin
  37.         cp:=CRCTablArrayHandle(crctabl)^;
  38.         while len>0 do begin
  39.             crc:=BXOR(CRCTablArrayHandle(crctabl)^^[BAND(BXOR(BSR(crc,8),BAND(p^,$FF)),$FF)],BSL(crc,8));
  40.             inc(longint(p));
  41.             dec(len);
  42.         end;
  43.     end;
  44.  
  45. {$ELSEC}
  46.  
  47.     procedure CalcMBCRCTabl (crctabl:Handle; var crc: integer; v: integer); external;
  48.     procedure CalcMBCRCBlockTabl (crctabl:Handle; p: univ Ptr; len: longint; var crc: integer); external;
  49.  
  50.     procedure CalcMBCRC (var crc: integer; v: integer);
  51.     begin
  52.         CalcMBCRCTabl(crctabl,crc,v);
  53.     end;
  54.     
  55.     procedure CalcMBCRCBlock (p: univ Ptr; len: longint; var crc: integer);
  56.     begin
  57.         CalcMBCRCBlockTabl(crctabl,p,len,crc);
  58.     end;
  59.  
  60. {$ENDC}
  61.  
  62.     function InitCalcCRC(var msg: integer):OSStatus;
  63.         var
  64.             err:OSErr;
  65.     begin
  66. {$unused(msg)}
  67.         crctabl:=Get1Resource('CRCt',128);
  68.         if crctabl<>nil then begin
  69.             MoveHHi(crctabl);
  70.             HLock(crctabl); { Must be locked, since these routines can be called at interupt time }
  71.             err:=noErr;
  72.         end else begin
  73.             err:=resNotFound;
  74.         end;
  75.         InitCalcCRC:=err;
  76.     end;
  77.  
  78.     procedure StartupCalcCRC;
  79.     begin
  80.         SetStartup(InitCalcCRC, nil, 0, nil);
  81.     end;
  82.  
  83. end.
  84.